perm filename SCHART.LSP[TIM,LSP]1 blob sn#763243 filedate 1984-08-02 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Chart Making program for TEX output.
C00006 00003	 The lines of a box are segments. So a Box would look like:
C00009 00004	 (do-schart-real 'tak)
C00023 ENDMK
CāŠ—;
;;; Chart Making program for TEX output.
;;; This is for making charts which are sorted best to worst, and
;;; possibly normalized. You can report CPU or REAL time.
;;;
;;; For each benchmark:
;;;(...(benchmark
;;;     ((blankline))
;;;     ((indent 1) "Benchmark 3" (entry (f entry)))
;;;     ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)


(declare (special *data* *benchmarks* *all-implementations* *normalize*
		  *all-implementations-flattened* *max-length*
		  *selectors* *subset-relationships* *all-benchmarks* *leave-outs*))
(sstatus syntax #o45 (status syntax #o40))
(declare (mapex t))

(setq *normalize* ())
(setq *max-length* ())
(setq *leave-outs* '(franz780yy franz780ny franz780nn s3600fpa
				franz750yy franz750ny franz750nn
				franz68kyy franz68kny franz68knn))

(declare (special *benchmark-info*))

(defun get-bench-data (bench)
       (cdr (assoc bench *data*)))

(defun get-bench-entry (impl full-entry)
       (cadr (assoc impl full-entry)))

(defmacro trunc (x)
	  `(//$ 
	    (float 
	     (fix 
	      (times 100.0 ,x))) 100.0))

(defun tsafe-quotient (x y)
       (cond ((and (numberp x)
		   (numberp y))
	      (cond ((and (zerop x)(zerop y))
		     1.0)
		    ((zerop y) '"$\infty$")
		    (t (round (quotient x y)))))))

(defmacro lookup-fun (impl type)
	  `(cadr (assq ,type (cadr (assq ,impl *selectors*)))))

(defun cadr-lessp (x y)
       (let ((q (cadr x))
	     (r (cadr y)))
	    (cond ((numberp q)
		   (cond ((numberp r)
			  (lessp q r))
			 (t t)))
		  (t ()))))

(defmacro infinity-ize (x)
	  `(let ((x ,x))
		(cond ((numberp x)
		       x)
		      ((eq x 'āˆž)
		       "$\infty$"))))

(defun filter-out (l leave-outs)
       (mapcan #'(lambda (x)
			 (cond ((memq (car x)
				      leave-outs)
				())
			       (t (ncons x))))
	       l))

(defun truncate-list (l len)
       (cond ((and (numberp len)
		   (lessp 0 len))
	      (mapcan #'(lambda (x)
				(cond ((zerop len) ())
				      (t (setq len (sub1 len))
					 (ncons x))))
		      l))
	     (t l))))

;;; The lines of a box are segments. So a Box would look like:
;;;	<blankline>
;;;	Division by 2
;;;	<blankline>
;;;	   Recursive
;;;	   Iterative
;;;	<blankline>


(defun make-a-chart (full-benchmark benchmark entry-fun type)
       (princ "&&\hfil {\bf Implementation}\hfil&&")
       (cond ((eq type 'cpu)
	      (princ "{\bf CPU}&\cr\tablerule"))
             (t
	      (princ "{\bf REAL}&\cr\tablerule")))
       (make-rows full-benchmark benchmark entry-fun type)
       t)

(defun make-rows (full-benchmark benchmark entry-fun type)
 (let  ((info
	 (get-bench-data full-benchmark)))
       (let ((data
	      (mapcar 
	       #'(lambda (impl)
			 (let ((entry (caddr impl)))
			      (list (car entry)
				    (let ((stuff
					   (funcall entry-fun 
						    (get-bench-entry
						     (cadr impl)
						     info)))
					  (fun (lookup-fun benchmark
							   type)))
      					 (and fun stuff
					      (funcall fun (car impl) stuff))))))
	       (filter-out *all-implementations-flattened* *leave-outs*))))
	    (setq data 
	     (truncate-list (sort data #'cadr-lessp) *max-length*))
	    (do ((data data (cdr data))
		 (best (cadr (car data))))
		((null data) t)
		(let ((impl-entry (car data)))
		     (terpri)
		     (princ "&&")
		     (princ (car impl-entry))
		     (princ "&&")
		     (cond ((null (cadr impl-entry)))
			   (t 
			    (cond (*normalize*
				   (princ (infinity-ize (safe-quotient
							 (cadr impl-entry)
							 best))))
				  (t (princ (trunc (cadr impl-entry)))))))
		     (princ "&\cr\tablerule")
		     (terpri))))))
;;; (do-schart-real 'tak)
;;; (do-schart-cpu 'traverse)
;;; (do-schart-real 'traverse-init)
;;; Look at *all-benchmarks* in DATA.BCH[TIM,LSP] to see the options.

(defun do-schart-real (benchmark)
       (let ((entry (cdr (assq benchmark *subset-relationships*))))
	    (terpri)
	    (princ "\newbox\bigstrutbox")
	    (terpri)
	    (princ "\setbox\bigstrutbox=\hbox{\vrule height9.6pt depth4.6pt width0pt}")
	    (terpri)
	    (princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}")
	    (terpri)
	    (cond (entry
		   (mapc #'(lambda (x) (do-schart1 benchmark x 'real)
				   (terpri)
				   (princ "\vfill\eject")
				   (terpri))(car entry)))
		  (t (do-schart1 benchmark benchmark 'real)))
	    t)))

(defun do-schart-cpu (benchmark)
       (let ((entry (cdr (assq benchmark *subset-relationships*))))
	    (terpri)
	    (princ "\newbox\bigstrutbox")
	    (terpri)
	    (princ "\setbox\bigstrutbox=\hbox{\vrule height10pt depth5.0pt width0pt}")
	    (terpri)
	    (princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}")
	    (terpri)
	    (cond (entry
		   (mapc #'(lambda (x) (do-schart1 benchmark x 'cpu)
				   (terpri)
				   (princ "\vfill\eject")
				   (terpri))(car entry)))
		  (t (do-schart1 benchmark benchmark 'cpu)))
	    t)))

(defun do-schart1 (full-benchmark benchmark type)
       (let ((n 1)(entry (cdr (assq benchmark *all-benchmarks*))))
	    (princ "$$\vbox{\tabskip=0pt \offinterlineskip")
	    (terpri)
	    (princ "\def\tablerule{\noalign{\hrule}}")
	    (terpri)
	    (princ "\halign {\bigstrut#& \vrule#\tabskip=1em plus2em&#& \vrule#&")
	    (do ((i (1- n) (1- i)))
		((zerop i)
		 (princ "\hfil#\hfil& \vrule#\tabskip=0pt\cr\tablerule")
		 (terpri)
		 (princ "&&\multispan{")(princ (1+ (* n 2)))
		 (princ "}\hfil ")
		 (cond ((eq type 'real)
			(princ "{\bf Real Time}"))
		       (t
			(princ "{\bf CPU Time}")))
		 (cond (*normalize*
			(princ " {\bf (Normalized)}")))
		 (princ "\hfil&\cr")
		 (terpri)
		 (princ "&&\multispan{")(princ (1+ (* n 2)))
		 (princ "}{\hfil {\bf ")(princ (car entry))
		 (princ "}}\hfil&\cr\tablerule")
		 (terpri)
		 )
		(princ "\hfil#\hfil& \vrule#&")(terpri))
       (make-a-chart
	full-benchmark benchmark
	(cadr entry) type)
       (princ "}}$$")))